home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / dfue / midi.net / midinet / midinet.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-04-19  |  24.6 KB  |  884 lines
  1. {$A+,D-,R-,P-,C-,T-}
  2. PROGRAM MIDInet;
  3.  
  4. { Netzwerkprogramm fuer alle ATART ST
  5.          (C) 1987 by Guenter Nowinski
  6.                  and Axel Buttchereit
  7.                      Moosholzweg 10
  8.                      3392 Clausthal-Zellerfeld 3 }
  9.  
  10.       {$I midinet.i}
  11.       {$Igemconst.pas}
  12.      midi=3;
  13.      key = 2;
  14.  
  15. TYPE
  16.    aes_ptr = ^char;
  17.    int_in_parms = ARRAY[0..15] OF integer;
  18.    int_out_parms = ARRAY[0..45] OF integer;
  19.    addr_in_parms = ARRAY[0..1] OF aes_ptr;
  20.    addr_out_parms = ARRAY[0..0] OF aes_ptr;
  21.    pfad_puffer = PACKED ARRAY[1..80] OF char;
  22.    pfad_zeiger_typ = ^pfad_puffer;
  23.  
  24.  
  25.    p128 = PACKED ARRAY[0..127] OF byte;
  26.    pack80 = PACKED ARRAY[1..80] OF char;
  27.  
  28.    janus = RECORD
  29.              CASE boolean OF
  30.                true : (adr : long_integer); { Pufferadresse}
  31.                false: (point:^daten)      { Dies ist der Puffer }
  32.              END;
  33.  
  34.    daten = RECORD
  35.              nummer     : integer;
  36.              sendreq    : boolean;
  37.              receivereq : boolean;
  38.              busy       : boolean;
  39.              auto_ack   : boolean;
  40.              ok_flag    : boolean;
  41.              ack        : ARRAY[1..15] OF boolean;
  42.              online     : ARRAY[1..15] OF boolean;
  43.              in_puffer  : p128;
  44.              out_puffer : p128;
  45.            END;
  46.  
  47.    int_puffer = RECORD
  48.                   CASE boolean OF
  49.                     true  : (adr : long_integer);
  50.                     false : (ptr : ^p128)
  51.                   END;
  52.  
  53.       {$I gemtype.pas}
  54.  
  55. VAR puffer : janus;
  56.     hpuffer : int_puffer;
  57.     in_puf_adr : long_integer;
  58.     p_midi1,p_datin,p_mesout,p_mesin,p_start,p_fehler,p_getquit : dialog_ptr;
  59.     p_infile,p_outfile,p_sendint,p_empfint,p_notonlin,
  60.     p_dateianf : dialog_ptr;
  61.     ap_id,menu_id:integer;
  62.     accname:str255;
  63.     dummy,event:integer;
  64.     an_set : SET OF 1..15;
  65.     msg:message_buffer;
  66.     midipfad : string;
  67.  
  68.  
  69.       {$Igemsubs.pas}
  70.  
  71. PROCEDURE aes_call(op : integer;
  72.                    VAR int_in   : int_in_parms;
  73.                    VAR int_out  : int_out_parms;
  74.                    VAR addr_in  : addr_in_parms;
  75.                    VAR addr_out : addr_out_parms);
  76.   EXTERNAL;
  77.  
  78.  
  79. PROCEDURE objc_draw(objekt : aes_ptr;
  80.                     index,tiefe : integer;
  81.                     x,y,b,h : integer);
  82. VAR
  83.   int_in   : int_in_parms;
  84.   int_out  : int_out_parms;
  85.   addr_in  : addr_in_parms;
  86.   addr_out : addr_out_parms;
  87.  
  88. BEGIN
  89. int_in[0] := index;
  90. int_in[1] := tiefe;
  91. int_in[2] := x;
  92. int_in[3] := y;
  93. int_in[4] := b;
  94. int_in[5] := h;
  95. addr_in[0] := objekt;
  96. aes_call(42,int_in,int_out,addr_in,addr_out)
  97. END;
  98.  
  99. FUNCTION bconstat(dev : integer):boolean; BIOS(1);   {MIDI: dev=3}
  100.  
  101. PROCEDURE dummy_bconin(dev : integer);    BIOS(2);   {MIDI: dev=3}
  102.  
  103. PROCEDURE bconout(dev : integer;C : char);BIOS(3);   {MIDI: dev=3}
  104.  
  105. PROCEDURE io_check(b:boolean); EXTERNAL;
  106.  
  107. FUNCTION io_result:integer; EXTERNAL;
  108.  
  109. PROCEDURE let_redraw;
  110. VAR dumdidum : integer;
  111. BEGIN
  112. event:=get_event(e_timer,0,0,0,1000,
  113.                  false,0,0,0,0,false,0,0,0,0,
  114.                   msg,dumdidum,dumdidum,dumdidum,dumdidum,dumdidum,dumdidum)
  115. END;
  116.  
  117. PROCEDURE clear_midi_buffer;
  118. BEGIN
  119. WHILE bconstat(midi) DO dummy_bconin(midi)
  120. END;
  121.  
  122. PROCEDURE clear_key_buffer;
  123. BEGIN
  124. WHILE bconstat(key) DO dummy_bconin(key)
  125. END;
  126.  
  127. PROCEDURE tastendruck;
  128. BEGIN
  129. clear_key_buffer;
  130. dummy_bconin(key)
  131. END;
  132.  
  133. PROCEDURE send_ack(von,an : integer);
  134. BEGIN
  135. bconout(midi,chr(von*16 + an));  {Ackn. von an}
  136. bconout(midi,chr(0));            {ist Datenblock der Länge 0}
  137. bconout(midi,chr(1))             {Checksum war OK}
  138. END;
  139.  
  140. PROCEDURE frei;
  141. BEGIN
  142. bconout(midi,chr(0))
  143. END;
  144.  
  145. PROCEDURE int_in_string(i : integer;VAR s : string);
  146. BEGIN
  147. s := chr(48 + i DIV 10);
  148. s := concat(s,chr(48 + i MOD 10))
  149. END;
  150.  
  151. PROCEDURE string_in_int( s : string; VAR i : integer);
  152. VAR j : integer;
  153. BEGIN
  154. i := 0;
  155. FOR j := length(s) DOWNTO 1 DO
  156.   i := i*10 + ord(s[j]) - 48
  157. END;
  158.  
  159. PROCEDURE dgetpath(ptr : pfad_zeiger_typ;drv : integer);
  160.   GEMDOS($47);
  161.  
  162. FUNCTION dgetdrv : integer;
  163.   GEMDOS($19);
  164.  
  165. PROCEDURE get_path(VAR path : string);
  166. VAR
  167.   l : integer;
  168.   pfad_pointer : pfad_zeiger_typ;
  169. BEGIN
  170.   new(pfad_pointer);
  171.   dgetpath(pfad_pointer,0);
  172.   l := 0;
  173.   WHILE pfad_pointer^[l+1] <> chr(0) DO
  174.   BEGIN
  175.     l := succ(l);
  176.     path[l] := pfad_pointer^[l]
  177.   END;
  178.   path[0] := chr(l);
  179.   path := concat(chr(dgetdrv+65),':',path,'\')
  180. END;
  181.  
  182. PROCEDURE standard_send(an : integer; VAR raus : boolean);
  183. VAR state,dummy : integer;
  184.     z : str255;
  185. BEGIN
  186. WITH puffer.point^ DO
  187. REPEAT
  188.   ack[an]:=false;
  189.   online[an] := true;
  190.   sendreq:=true;
  191.   WHILE sendreq DO;
  192.   busy:=false;
  193.   WHILE NOT busy DO;
  194.   IF NOT ack[an] THEN
  195.     IF online[an] THEN
  196.       BEGIN
  197.         state := obj_state(p_fehler,fabbruch);
  198.         obj_setstate(p_fehler,fabbruch,state & $fe,false);
  199.         state := obj_state(p_fehler,fweiter);
  200.         obj_setstate(p_fehler,fweiter,state & $fe,false);
  201.         int_in_string(an,z);
  202.         z := concat('(',z,')');
  203.         set_dtext(p_fehler,fehleran,z,system_font,te_left);
  204.         center_dialog(p_fehler);
  205.         raus := (do_dialog(p_fehler,0) = fabbruch);
  206.         end_dialog(p_fehler);
  207.         let_redraw;
  208.       END
  209.     ELSE BEGIN
  210.          state := obj_state(p_notonlin,noknopf);
  211.          obj_setstate(p_notonlin,noknopf,state & $fe,false);
  212.          int_in_string(an,z);
  213.          z := concat('(',z,')');
  214.          set_dtext(p_notonlin,notonan,z,system_font,te_left);
  215.          center_dialog(p_notonlin);
  216.          dummy := do_dialog(p_notonlin,0);
  217.          raus := true;
  218.          end_dialog(p_notonlin);
  219.          let_redraw
  220.          END
  221. UNTIL (ack[an] AND ok_flag) OR raus;
  222. END;
  223.  
  224. FUNCTION fopen(VAR name : pack80; mode : integer):integer;
  225.   GEMDOS($3d);
  226.  
  227. FUNCTION fread(h_nummer : integer; count,buf : long_integer):integer;
  228.   GEMDOS($3f);
  229.  
  230. PROCEDURE fwrite(h_nummer : integer; count,buf : long_integer);
  231.   GEMDOS($40);
  232.  
  233. PROCEDURE fclose(h_nummer : integer);
  234.   GEMDOS($3e);
  235.  
  236. FUNCTION my_reset(fn : str255):integer;
  237. { liefert im Fehlerfall negativen Wert }
  238. VAR name : pack80;
  239.     i,l : integer;
  240. BEGIN
  241. l := length(fn);
  242. FOR i := 1 TO l DO
  243.   name[i] := fn[i];
  244. name[l+1] := chr(0);
  245. my_reset := fopen(name,0)
  246. END;
  247.  
  248. PROCEDURE res_laden;
  249. VAR vonwo:string;
  250.   FUNCTION getrez:integer;
  251.   XBIOS(4);
  252.  
  253. BEGIN
  254.   IF getrez=2 {hohe Aufloesung}
  255.   THEN vonwo:=concat(midipfad,'midimono.rsc')
  256.     ELSE vonwo:=concat(midipfad,'midicol.rsc');
  257.   IF NOT load_resource(vonwo) THEN
  258.     BEGIN
  259.       dummy:=do_alert('[3][Es fehlt die Resource-Datei][Abbruch]',1);
  260.       exit_gem;
  261.       halt
  262.     END;
  263.   find_dialog(midi1,p_midi1);
  264.   find_dialog(datin,p_datin);
  265.   find_dialog(mesout,p_mesout);
  266.   find_dialog(mesin,p_mesin);
  267.   find_dialog(start,p_start);
  268.   find_dialog(fehler,p_fehler);
  269.   find_dialog(getquit,p_getquit);
  270.   find_dialog(infile,p_infile);
  271.   find_dialog(outfile,p_outfile);
  272.   find_dialog(sendint,p_sendint);
  273.   find_dialog(empfint,p_empfint);
  274.   find_dialog(notonlin,p_notonlin);
  275.   find_dialog(dateianf,p_dateianf)
  276. END;
  277.  
  278.  
  279. PROCEDURE installieren(adresse:long_integer);
  280. { Diese Routine stellt den Pfad fest,
  281.   installiert die VBI-Routine fuer den
  282.   MIDInet Server und uebergibt ihr die Adresse des Puffers. }
  283. TYPE name=PACKED ARRAY[1..80] OF char;
  284.  
  285. VAR pfad:name;
  286.     pfadstr,cmdline,env:string;
  287.     wahl,i:integer;
  288.  
  289.   PROCEDURE pexec(mode:integer; VAR path:name;
  290.                   VAR cmdline:string;VAR env:string);
  291.   GEMDOS($4b);
  292.  
  293. BEGIN
  294.   center_dialog(p_start);
  295.   begin_update;
  296.   wahl := do_dialog(p_start,0);
  297.   end_update;
  298.   end_dialog(p_start);
  299.   WITH puffer.point^ DO
  300.   BEGIN
  301.     CASE wahl OF
  302.       sm1 : nummer := 1;
  303.       sm2 : nummer := 2;
  304.       sm3 : nummer := 3;
  305.       sm4 : nummer := 4;
  306.       sm5 : nummer := 5;
  307.       sm6 : nummer := 6;
  308.       sm7 : nummer := 7;
  309.       sm8 : nummer := 8;
  310.       sm9 : nummer := 9;
  311.       sm10: nummer := 10;
  312.       sm11: nummer := 11;
  313.       sm12: nummer := 12;
  314.       sm13: nummer := 13;
  315.       sm14: nummer := 14;
  316.       sm15: nummer := 15
  317.     END;
  318.     sendreq:=false;
  319.     receivereq:=false;
  320.     busy:=false;
  321.     auto_ack := true
  322.   END;
  323.   pfadstr:=concat(midipfad,'MIDINET.PRG');
  324.   FOR i:=1 TO length(pfadstr) DO pfad[i]:=pfadstr[i];
  325.   pfad[length(pfadstr)+1]:=chr(0);
  326.          { cmdline darf keine $00 enthalten, sonst vorzeitiges Ende! }
  327.   FOR i:=0 TO 5 DO
  328.   BEGIN
  329.     cmdline[i]:=chr((adresse MOD 16)+64);
  330.     adresse:=adresse DIV 16;
  331.   END;
  332.   cmdline[6]:=chr(0);
  333.   env[0]:=chr(0);
  334.   pexec(0,pfad,cmdline,env)   { Jetzt starten }
  335. END;
  336.  
  337.  
  338. PROCEDURE nachrichtsend;
  339. VAR adr,wort1,wort2,z,z1,z2:str255;
  340.     i,j,dummy,state:integer;
  341.     raus : boolean;
  342. BEGIN
  343. center_dialog(p_mesout);
  344. z := 'An';
  345. FOR i := 1 TO 15 DO
  346.   IF i IN an_set THEN
  347.     BEGIN
  348.     int_in_string(i,adr);
  349.     z := concat(z,' ',adr)
  350.     END;
  351. set_dtext(p_mesout,meldan,z,system_font,te_left);
  352. REPEAT
  353.   z1:='__________________________________________________';
  354.   z2:='XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
  355.   set_dedit(p_mesout,meld2,z1,z2,'',system_font,te_left);
  356.   z1:=concat('Meldung   ',z1);
  357.   set_dedit(p_mesout,meld1,z1,z2,'',system_font,te_left);
  358.   state := obj_state(p_mesout,clear);
  359.   obj_setstate(p_mesout,clear,state & $fe,false);
  360.   state := obj_state(p_mesout,textok);
  361.   obj_setstate(p_mesout,textok,state & $fe,false);
  362.   state := obj_state(p_mesout,outstop);
  363.   obj_setstate(p_mesout,outstop,state & $fe,false);
  364.   dummy:=do_dialog(p_mesout,0)
  365. UNTIL dummy<>clear;
  366. end_dialog(p_mesout);
  367. let_redraw;
  368. IF dummy<>outstop THEN
  369.   BEGIN
  370.     get_dedit(p_mesout,meld1,wort1);
  371.     get_dedit(p_mesout,meld2,wort2);
  372.     WITH puffer.point^ DO
  373.       BEGIN
  374.         j:=2;
  375.         FOR i:=1 TO length(wort1) DO
  376.           BEGIN
  377.             out_puffer[j]:=ord(wort1[i]);
  378.             j:=succ(j)
  379.           END;
  380.         out_puffer[j]:=255; {Trennzeichen}
  381.         j:=succ(j);
  382.         FOR i:=1 TO length(wort2) DO
  383.           BEGIN
  384.             out_puffer[j]:=ord(wort2[i]);
  385.             j:=succ(j)
  386.           END;
  387.         out_puffer[j]:=0;  { Endezeichen }
  388.         out_puffer[1]:=j-1; {Zeichenanzahl incl. Endezeichen}
  389.       END;
  390.     FOR i := 1 TO 15 DO
  391.       IF i IN an_set THEN
  392.         WITH puffer.point^ DO
  393.           BEGIN
  394.             out_puffer[0]:=i+16*nummer;
  395.             standard_send(i,raus)
  396.           END
  397.   END
  398. END;
  399.  
  400.  
  401. PROCEDURE nachrempfang;
  402. VAR i,dummy,absend:integer;
  403.     z:str255;
  404. BEGIN
  405.   write(chr(7));
  406.   WITH puffer.point^ DO
  407.   BEGIN
  408.     absend:=in_puffer[0] DIV 16;
  409.     int_in_string(absend,z);
  410.     z := concat('Meldung von ',z);
  411.     set_dtext(p_mesin,meldvon,z,system_font,te_left);
  412.     z:='';
  413.     i:=1;
  414.     WHILE (i<ord(in_puffer[1])) AND (in_puffer[i+1]<>255) DO
  415.     BEGIN
  416.       z:=concat(z,chr(in_puffer[i+1]));
  417.       i:=succ(i)
  418.     END;
  419.     set_dtext(p_mesin,intext1,z,system_font,te_left);
  420.     z:='';
  421.     i:=succ(i);
  422.     WHILE i<ord(in_puffer[1]) DO
  423.     BEGIN
  424.       z:=concat(z,chr(in_puffer[i+1]));
  425.       i:=succ(i)
  426.     END;
  427.     set_dtext(p_mesin,intext2,z,system_font,te_left);
  428.     center_dialog(p_mesin);
  429.     objc_draw(p_mesin,0,1,0,0,639,399);
  430.     tastendruck;
  431.     receivereq:=false;
  432.     end_dialog(p_mesin);
  433.     let_redraw;
  434.   END
  435. END;
  436.  
  437. PROCEDURE bereit(VAR anz:integer;h_nummer,ani:integer);
  438. BEGIN
  439. anz := fread(h_nummer,124,hpuffer.adr+2);
  440. hpuffer.ptr^[0] := puffer.point^.nummer * 16 + ani;
  441. hpuffer.ptr^[1] := anz + 1;
  442. IF anz < 124
  443.   THEN hpuffer.ptr^[anz+2] := 0
  444.   ELSE hpuffer.ptr^[anz+2] := 255
  445. END;
  446.  
  447.  
  448. PROCEDURE warten(ani:integer);
  449. VAR quittiert : boolean;
  450.     z:str255;
  451. BEGIN
  452. quittiert := false;
  453. int_in_string(ani,z);
  454. z := concat('(',z,')');
  455. set_dtext(p_getquit,quitan,z,system_font,te_left);
  456. center_dialog(p_getquit);
  457. objc_draw(p_getquit,0,1,0,0,639,399);
  458. WITH puffer.point^ DO
  459.   BEGIN
  460.     REPEAT
  461.       WHILE NOT receivereq DO;
  462.       IF (in_puffer[0] DIV 16 = ani) AND
  463.          (in_puffer[1] = 3) AND
  464.          (in_puffer[2] = 0) AND
  465.          (in_puffer[3] = ord('Q'))
  466.         THEN quittiert := true
  467.         ELSE nachrempfang
  468.     UNTIL quittiert;
  469.     receivereq := false;
  470.     end_dialog(p_getquit);
  471.     let_redraw;
  472.   END
  473. END;
  474.  
  475. PROCEDURE meldung(empf:integer;meldtext:string);
  476. VAR i:integer;
  477.      raus:boolean;
  478. BEGIN
  479.   WITH puffer.point^ DO
  480.   BEGIN
  481.     WHILE sendreq DO;
  482.     FOR i:=1 TO length(meldtext) DO
  483.       out_puffer[i+1]:=ord(meldtext[i]);
  484.     i:=length(meldtext);
  485.     out_puffer[0]:=empf+16*puffer.point^.nummer;
  486.     out_puffer[1]:=i+1;
  487.     out_puffer[i+2]:=0;
  488.     raus := false;
  489.     REPEAT
  490.       standard_send(empf,raus)
  491.     UNTIL NOT raus
  492.   END
  493. END;
  494.  
  495. PROCEDURE transfer(auswahl:path_name;ani:integer);
  496. VAR i,j,l,state,h_nummer,anz:integer;
  497.     z:str255;
  498.     raus,schluss:boolean;
  499. BEGIN
  500.   h_nummer:=my_reset(auswahl);
  501.   fclose(h_nummer);
  502.   IF h_nummer<0 THEN
  503.     meldung(ani,'Die angeforderte Datei existiert nicht.')
  504.   ELSE
  505.   WITH puffer.point^ DO
  506.   BEGIN
  507.     let_redraw;
  508.     i := length(auswahl);
  509.     WHILE auswahl[i]<>'\' DO i:=pred(i);
  510.     i := succ(i);
  511.     l := 0;
  512.     j := 3;
  513.     WHILE (i<=length(auswahl)) DO
  514.       BEGIN
  515.         l := succ(l);
  516.         out_puffer[j]:=ord(auswahl[i]);
  517.         i:=succ(i);
  518.         j:=succ(j)
  519.       END;
  520.     out_puffer[0]:=ani+16*nummer;
  521.     out_puffer[1]:=l+2;
  522.     out_puffer[2]:=0;
  523.     out_puffer[j]:=0;
  524.     raus := false;
  525.     standard_send(ani,raus);
  526.     IF NOT raus THEN
  527.       BEGIN
  528.         warten(ani);
  529.         z := concat('Lesen von: ',auswahl);
  530.         set_dtext(p_outfile,outfin,z,system_font,te_left);
  531.         int_in_string(ani,z);
  532.         z := concat('Senden an: ',z);
  533.         set_dtext(p_outfile,outfnr,z,system_font,te_left);
  534.         center_dialog(p_outfile);
  535.         objc_draw(p_outfile,0,1,0,0,639,399);
  536.         schluss := false;
  537.         h_nummer := my_reset(auswahl);
  538.         IF h_nummer>=0 THEN
  539.         BEGIN
  540.           bereit(anz,h_nummer,ani);
  541.           REPEAT
  542.             out_puffer := hpuffer.ptr^;
  543.             ack[ani] := false;
  544.             sendreq := true;
  545.             schluss := (anz < 124);
  546.             IF NOT schluss THEN bereit(anz,h_nummer,ani);
  547.             REPEAT
  548.               WHILE sendreq DO;
  549.               busy := false;
  550.               WHILE NOT busy DO;
  551.               IF NOT ack[ani] THEN
  552.                 BEGIN
  553.                 state := obj_state(p_sendint,siknopf);
  554.                 obj_setstate(p_sendint,siknopf,state & $fe,false);
  555.                 int_in_string(ani,z);
  556.                 z := concat('(',z,')');
  557.                 set_dtext(p_sendint,sendan,z,system_font,te_left);
  558.                 center_dialog(p_sendint);
  559.                 dummy := do_dialog(p_sendint,0);
  560.                 end_dialog(p_sendint);
  561.                 let_redraw
  562.                 END
  563.               ELSE IF NOT ok_flag THEN
  564.                      BEGIN
  565.                        sendreq := true;
  566.                        ack[ani] := false;
  567.                        write(chr(7))
  568.                      END
  569.             UNTIL ack[ani] AND ok_flag
  570.           UNTIL schluss
  571.         END;
  572.         fclose(h_nummer);
  573.         end_dialog(p_outfile);
  574.         let_redraw;
  575.       END
  576.   END
  577. END;
  578.  
  579. PROCEDURE dateisend;
  580. VAR vorgabe,auswahl:path_name;
  581.     z : str255;
  582.     i,j,l,h_nummer,anz,state,ani:integer;
  583.     raus,schluss : boolean;
  584.  
  585. BEGIN
  586. auswahl:='';
  587. get_path(vorgabe);
  588. vorgabe:=concat(vorgabe,'*.*');
  589. IF get_in_file(vorgabe,auswahl) THEN
  590.   FOR ani := 1 TO 15 DO
  591.     IF ani IN an_set THEN
  592.       transfer(auswahl,ani)
  593. END;
  594.  
  595. PROCEDURE holedatei;
  596. VAR i,state,von:integer;
  597.     z,z1,z2,pfad:str255;
  598.     raus:boolean;
  599. BEGIN
  600.   state := obj_state(p_dateianf,anfanf);
  601.   obj_setstate(p_dateianf,anfanf,state & $fe,false);
  602.   state := obj_state(p_dateianf,anfaus);
  603.   obj_setstate(p_dateianf,anfaus,state & $fe,false);
  604.   z1:='Pfad  __________________________________________________';
  605.   z2:='XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
  606.   set_dedit(p_dateianf,anfpfad,z1,z2,'',system_font,te_left);
  607.   i:=1;
  608.   WHILE NOT (i IN an_set) DO i:=succ(i);
  609.   von:=i;
  610.   int_in_string(i,z);
  611.   z:=concat('Hole Datei von ',z);
  612.   set_dtext(p_dateianf,anfvon,z,system_font,te_left);
  613.   center_dialog(p_dateianf);
  614.   dummy:=do_dialog(p_dateianf,0);
  615.   IF dummy=anfanf THEN
  616.   BEGIN
  617.     WHILE puffer.point^.sendreq DO;
  618.     get_dedit(p_dateianf,anfpfad,pfad);
  619.     FOR i:=1 TO length(pfad) DO
  620.       puffer.point^.out_puffer[i+2]:=ord(pfad[i]);
  621.     puffer.point^.out_puffer[0]:=von+16*puffer.point^.nummer;
  622.     puffer.point^.out_puffer[1]:=i+2;
  623.     puffer.point^.out_puffer[2]:=1;
  624.     puffer.point^.out_puffer[i+3]:=0;
  625.     raus := false;
  626.     standard_send(von,raus);
  627.   END;
  628.   end_dialog(p_dateianf);
  629. END;
  630.  
  631.  
  632. PROCEDURE datanford;
  633. VAR auswahl,meldtext,vergleich:str255;
  634.     i,empf:integer;
  635.     zugriff:text;
  636.     freigabe:boolean;
  637. BEGIN
  638.   auswahl:='';
  639.   WITH puffer.point^ DO
  640.   BEGIN
  641.     FOR i:=3 TO in_puffer[1]-1 DO
  642.       BEGIN
  643.         IF (in_puffer[i]>96) AND (in_puffer[i]<123)
  644.           THEN in_puffer[i]:=in_puffer[i]-32;   {in Grossbuchst. wandeln}
  645.         auswahl:=concat(auswahl,chr(in_puffer[i]));
  646.       END;
  647.     empf:=in_puffer[0] DIV 16;
  648.     receivereq:=false;
  649.     freigabe:=false;
  650.     io_check(false);
  651.     reset(zugriff,concat(midipfad,'midinet.inf'));
  652.     IF io_result=0 THEN
  653.     BEGIN
  654.       REPEAT
  655.         readln(zugriff,vergleich);
  656.         IF pos(vergleich,auswahl)=1 THEN freigabe:=true;
  657.       UNTIL eof(zugriff);
  658.       close(zugriff)
  659.     END;
  660.     io_check(true);
  661.     IF freigabe THEN transfer(auswahl,empf)
  662.     ELSE
  663.       meldung(empf,'Die angeforderte Datei ist gesperrt !');
  664.   END
  665. END;
  666.  
  667.  
  668. PROCEDURE aktion;
  669. VAR an,wahl,state,dumdidum:integer;
  670.     z : str255;
  671. BEGIN
  672. REPEAT
  673.   center_dialog(p_midi1);
  674.   state := obj_state(p_midi1,nachri);
  675.   obj_setstate(p_midi1,nachri,state & $fe,false);
  676.   state := obj_state(p_midi1,datei);
  677.   obj_setstate(p_midi1,datei,state & $fe,false);
  678.   state := obj_state(p_midi1,dateihol);
  679.   obj_setstate(p_midi1,dateihol,state & $fe,false);
  680.   state := obj_state(p_midi1,ausgang);
  681.   obj_setstate(p_midi1,ausgang,state & $fe,false);
  682.   wahl := do_dialog(p_midi1,0);
  683.   end_dialog(p_midi1);
  684.   let_redraw;
  685.   an_set := [];
  686.   IF obj_state(p_midi1,em1 ) & selected <>0 THEN an_set := an_set + [1];
  687.   IF obj_state(p_midi1,em2 ) & selected <>0 THEN an_set := an_set + [2];
  688.   IF obj_state(p_midi1,em3 ) & selected <>0 THEN an_set := an_set + [3];
  689.   IF obj_state(p_midi1,em4 ) & selected <>0 THEN an_set := an_set + [4];
  690.   IF obj_state(p_midi1,em5 ) & selected <>0 THEN an_set := an_set + [5];
  691.   IF obj_state(p_midi1,em6 ) & selected <>0 THEN an_set := an_set + [6];
  692.   IF obj_state(p_midi1,em7 ) & selected <>0 THEN an_set := an_set + [7];
  693.   IF obj_state(p_midi1,em8 ) & selected <>0 THEN an_set := an_set + [8];
  694.   IF obj_state(p_midi1,em9 ) & selected <>0 THEN an_set := an_set + [9];
  695.   IF obj_state(p_midi1,em10) & selected <>0 THEN an_set := an_set + [10];
  696.   IF obj_state(p_midi1,em11) & selected <>0 THEN an_set := an_set + [11];
  697.   IF obj_state(p_midi1,em12) & selected <>0 THEN an_set := an_set + [12];
  698.   IF obj_state(p_midi1,em13) & selected <>0 THEN an_set := an_set + [13];
  699.   IF obj_state(p_midi1,em14) & selected <>0 THEN an_set := an_set + [14];
  700.   IF obj_state(p_midi1,em15) & selected <>0 THEN an_set := an_set + [15]
  701. UNTIL (an_set <> []) OR (wahl = ausgang);
  702. CASE wahl OF
  703.           nachri : nachrichtsend;
  704.           datei  : BEGIN
  705.                      WITH puffer.point^ DO
  706.                        IF nummer IN an_set THEN
  707.                          an_set := an_set - [nummer];
  708.                      IF an_set <> [] THEN dateisend;
  709.                    END;
  710.           dateihol : BEGIN
  711.                        WITH puffer.point^ DO
  712.                          IF nummer IN an_set THEN
  713.                            an_set := an_set - [nummer];
  714.                        IF an_set <> [] THEN holedatei;
  715.                      END;
  716.           ausgang: ; {die leere Anweisung, aber das sofort !!!}
  717.   END  { of Käs }
  718. END;
  719.  
  720.  
  721. PROCEDURE dateiempfang;
  722. VAR z : str255;
  723.     fn : string;
  724.     i,dummy,absender,h_nummer,state : integer;
  725.     schluss,ausgewaehlt : boolean;
  726.     vorgabe,auswahl : path_name;
  727.     datei : PACKED FILE OF byte;
  728.  
  729.   PROCEDURE quittung;
  730.   BEGIN
  731.     WITH puffer.point^ DO
  732.       REPEAT
  733.         out_puffer[0] := nummer*16 + absender;
  734.         out_puffer[1] := 3;
  735.         out_puffer[2] := 0;
  736.         out_puffer[3] := ord('Q');
  737.         out_puffer[4] := 0;
  738.         ack[absender] := false;
  739.         sendreq := true;
  740.         WHILE sendreq DO;
  741.         busy := false;
  742.         WHILE NOT busy DO;
  743.         IF NOT ack[absender] THEN
  744.           BEGIN
  745.           state := obj_state(p_empfint,eiknopf);
  746.           obj_setstate(p_empfint,eiknopf,state & $fe,false);
  747.           int_in_string(absender,z);
  748.           z := concat('(',z,')');
  749.           set_dtext(p_empfint,empfan,z,system_font,te_left);
  750.           center_dialog(p_empfint);
  751.           dummy := do_dialog(p_empfint,0);
  752.           end_dialog(p_empfint);
  753.           let_redraw
  754.           END
  755.       UNTIL ack[absender] AND ok_flag
  756.   END;
  757.  
  758. BEGIN
  759.   center_dialog(p_datin);
  760.   absender:=puffer.point^.in_puffer[0] DIV 16;
  761.   int_in_string(absender,z);
  762.   z:=concat('Absender: ',z);
  763.   set_dtext(p_datin,absend,z,system_font,te_left);
  764.   fn := '';
  765.   FOR i:=3 TO puffer.point^.in_puffer[1] + 1 DO
  766.     fn := concat(fn,chr(puffer.point^.in_puffer[i]));
  767.   z := concat('Die Datei ',fn);
  768.   set_dtext(p_datin,datname,z,system_font,te_left);
  769.   state := obj_state(p_datin,pfadwahl);
  770.   obj_setstate(p_datin,pfadwahl,state & $fe,false);
  771.   state := obj_state(p_datin,pfada);
  772.   obj_setstate(p_datin,pfada,state & $fe,false);
  773.   state := obj_state(p_datin,pfadb);
  774.   obj_setstate(p_datin,pfadb,state & $fe,false);
  775.   state := obj_state(p_datin,pfadc);
  776.   obj_setstate(p_datin,pfadc,state & $fe,false);
  777.   state := obj_state(p_datin,pfadd);
  778.   obj_setstate(p_datin,pfadd,state & $fe,false);
  779.   dummy:=do_dialog(p_datin,0);
  780.   end_dialog(p_datin);
  781.   let_redraw;
  782.   CASE dummy OF
  783.              pfada : auswahl := concat('A:\',fn);
  784.              pfadb : auswahl := concat('B:\',fn);
  785.              pfadc : auswahl := concat('C:\',fn);
  786.              pfadd : auswahl := concat('D:\',fn);
  787.              ELSE  : REPEAT
  788.                        get_path(vorgabe);
  789.                        auswahl:=concat(vorgabe,fn);
  790.                        vorgabe:=concat(vorgabe,'*.*');
  791.                        ausgewaehlt := get_in_file(vorgabe,auswahl);
  792.                        let_redraw
  793.                      UNTIL ausgewaehlt
  794.        END;
  795.   io_check(false);
  796.   rewrite(datei,auswahl);
  797.   WHILE io_result<>0 DO
  798.   BEGIN
  799.     REPEAT
  800.       get_path(vorgabe);
  801.       auswahl:=concat(vorgabe,fn);
  802.       vorgabe:=concat(vorgabe,'*.*');
  803.       ausgewaehlt:=get_in_file(vorgabe,auswahl)
  804.     UNTIL ausgewaehlt;
  805.     rewrite(datei,auswahl)
  806.   END;
  807.   io_check(true);
  808.   h_nummer := handle(datei);
  809.   quittung;
  810.   int_in_string(absender,z);
  811.   z := concat('Empfangen von: ',z);
  812.   set_dtext(p_infile,infnr,z,system_font,te_left);
  813.   z := concat('Lesen von:      ',fn);
  814.   set_dtext(p_infile,infin,z,system_font,te_left);
  815.   z := concat('Schreiben nach: ',auswahl);
  816.   set_dtext(p_infile,infout,z,system_font,te_left);
  817.   center_dialog(p_infile);
  818.   objc_draw(p_infile,0,1,0,0,639,399);
  819.   puffer.point^.auto_ack := false;
  820.   puffer.point^.receivereq := false;
  821.   schluss := false;
  822.   WITH puffer.point^ DO
  823.   REPEAT
  824.     WHILE NOT receivereq DO;
  825.     IF (in_puffer[0] DIV 16 = absender) THEN
  826.       BEGIN
  827.       send_ack(nummer,absender);
  828.       schluss := (in_puffer[in_puffer[1]+1] = 0);
  829.       IF NOT schluss THEN receivereq := false;
  830.       fwrite(h_nummer,in_puffer[1]-1,in_puf_adr + 2)
  831.       END
  832.     ELSE receivereq:=false;
  833.     IF NOT schluss THEN frei
  834.   UNTIL schluss;
  835.   puffer.point^.auto_ack := true;
  836.   puffer.point^.receivereq:=false;
  837.   frei;
  838.   close(datei);
  839.   end_dialog(p_infile);
  840.   let_redraw
  841. END;
  842.  
  843.  
  844. PROCEDURE empfang;
  845. BEGIN
  846.   CASE puffer.point^.in_puffer[2] OF
  847.   0 : dateiempfang;
  848.   1 : datanford;
  849.   ELSE : nachrempfang
  850.   END
  851. END;
  852.  
  853.  
  854. BEGIN
  855. ap_id:=init_gem;
  856. IF ap_id>=0 THEN
  857.   BEGIN
  858.     get_path(midipfad);
  859.     accname:='  MIDInet Server';
  860.     menu_id:=menu_register(ap_id,accname);
  861.       event:=get_event(e_timer,0,0,0,3000,
  862.                        false,0,0,0,0,false,0,0,0,0,
  863.                        msg,dummy,dummy,dummy,dummy,dummy,dummy);
  864.     init_mouse;
  865.     new(puffer.point); { Puffer erzeugen }
  866.     in_puf_adr := puffer.adr + 72;  {Adresse des Eingabepuffers}
  867.     new(hpuffer.ptr);  {Hilfspuffer erzeugen}
  868.     res_laden; { Resource laden und Nummer feststellen }
  869.     installieren(puffer.adr);
  870.     clear_midi_buffer;
  871.     frei;
  872.     WHILE true DO
  873.     BEGIN { Event-loop }
  874.       event:=get_event(e_message | e_timer,0,0,0,100,
  875.                        false,0,0,0,0,false,0,0,0,0,
  876.                        msg,dummy,dummy,dummy,dummy,dummy,dummy);
  877.       IF puffer.point^.receivereq THEN empfang;
  878.       IF event&e_message<>0
  879.         THEN IF (msg[0]=ac_open) THEN aktion
  880.     END;
  881.     exit_gem
  882.   END;
  883. END.
  884.